home *** CD-ROM | disk | FTP | other *** search
/ Mastering Computers 3 / Mastering Computers Vol 3.iso / Win95 / Fun&Utils / GROUPS.ZIP / GROUPS.SM < prev    next >
Encoding:
Text File  |  1994-06-16  |  18.0 KB  |  647 lines
  1. /**************************************************************************************
  2. *  Group Transfer program
  3. *
  4. * (C) 1994 Rob Harford
  5. * Last Modified : 15 june 1994
  6. * 9/feb/94    - fixed problem with group names compising of other group names
  7. * 14/jun/1994 - fixed problem with spaces at the end of group names
  8. * 15/june/1994 - Added the 3d Dialog boxes
  9. * Release version 1.04
  10. ****************************************************************************************/
  11.  
  12. /***************************************************************************************
  13. * 
  14. * Delare sub routines to enable 3d Dialog boxes within script maker
  15. *
  16. ******************************************************************************************/
  17.  
  18.  
  19. declare function Ctl3dRegister lib "ctl3d.dll" (byval hInst as Long) as Integer
  20. declare function Ctl3dAutoSubClass lib "ctl3d.dll" (byval hInst as Long) as Integer
  21. declare function Ctl3dUnRegister lib "ctl3d.dll" (byval hInst as Long) as Integer
  22.  
  23.  
  24. /***************************************************************************************
  25. * 
  26. *    Function:  Encap$
  27. *    Parameters:Cmd$
  28. *    Purpose:    This routine encapusulates the groupname, to protect against spaces at
  29. *        the end or start of a group name
  30. *
  31. ******************************************************************************************/
  32.  
  33. function Encap$(groupname$)
  34.  Encap$=chr$(34)+groupname$+chr$(34)
  35. end function
  36.  
  37. /***************************************************************************************
  38. * 
  39. *    Function:  DDEexe
  40. *    Parameters:Cmd$
  41. *    Purpose:    This sub routine opens a DDE channel to the current shell, and then
  42. *        sends the command string ,held in Cmd$
  43. *
  44. ******************************************************************************************/
  45.  
  46. sub DDEexe(Cmd$)
  47.  
  48.     Dim DDEchannel as Integer
  49.  
  50.     DDEchannel = DDEInitiate("progman", "progman")
  51.     if DDEchannel = FALSE then 
  52.         MsgBox "Unable To Access Windows Shell. Either the primary Windows shell is not responding, or is incompatible with this script..", 16, "FATAL ERROR"
  53.     Else
  54.         DDEExecute DDEchannel, Cmd$ 
  55.         DDETerminate DDEchannel 
  56.     End If
  57. end sub
  58.  
  59. /* **************************************************************************************
  60. * 
  61. *    Function:    DDEget$
  62. *    Parameters:Cmd$
  63. *    Purpose:    This function opens a DDE channel to the current shell, then requests
  64. *        information based upon the contents of Cmd$
  65. *
  66. ******************************************************************************************/
  67. function DDEget$(g$)
  68.  
  69.     Dim DDEchannel as Integer
  70.  
  71.     DDEchannel = DDEInitiate("progman", "progman")
  72.     if DDEchannel = FALSE then 
  73.         MsgBox "Unable To Access Windows Shell. Either the primary Windows shell is not responding, or is incompatible with this script.", 16, "FATAL ERROR"
  74.     Else
  75.           DDEget$=DDErequest$(DDEchannel,g$)
  76.         DDETerminate DDEchannel 
  77.     end if
  78. end function
  79.  
  80.  
  81. /* **************************************************************************************
  82. * 
  83. *    Function:    DeleteItem
  84. *    Parameters:Group$
  85. *    Purpose:    This deletes an item from within a group from the shell
  86. *        e.g DeleteItem "File Manager"
  87. ******************************************************************************************/
  88.  
  89. sub DeleteItem (Group$)
  90.     Group$= "[ReplaceItem("+Group$+")]" 
  91.     DDEExe Group$ 
  92. End Sub
  93.  
  94. /* **************************************************************************************
  95. * 
  96. *    Function:    CreateGroup
  97. *    Parameters:Group$
  98. *    Purpose:    This creates a group from the shell
  99. *        e.g CreateGroup "Main"
  100. ******************************************************************************************/
  101.  
  102. sub CreateGroup (Group$)
  103.     Group$= "[CreateGroup("+CHR$(34)+Group$+CHR$(34)+", )]" 
  104.     DDEExe Group$ 
  105. End Sub
  106. /* **************************************************************************************
  107. * 
  108. *    Function:    MakeCompat$
  109. *    Parameters:Data$
  110. *    Purpose:    This untily removes brackets which may offend program manager.
  111. *
  112. ******************************************************************************************/
  113.  
  114.  
  115. function MakeCompat$(Data$)
  116.     
  117.     a=0
  118.  
  119.     Bad$="[]{}"
  120.     New$=""
  121.  
  122.     while (a<len(Data$))
  123.         a=a+1
  124.         c$=Mid$(Data$,a,1)
  125.         if (InStr(Bad$,c$)<>0) then
  126.             New$=New$+"."
  127.         else
  128.             New$=New$+c$
  129.         End if
  130.     Wend
  131.     MakeCompat$=New$
  132. end function
  133.  
  134. /* **************************************************************************************
  135. * 
  136. *    Function:    MakeComma$
  137. *    Parameters:Information$
  138. *    Purpose:    This converts the information received by GetGroups, and then adds 
  139. *        commas between each group name.
  140. *
  141. ******************************************************************************************/
  142.  
  143.  
  144. Function MakeComma$(Information$)
  145.  
  146.     a=1
  147.     mk$ =""
  148.     while (a<=Len(Information$))
  149.         if Mid$(Information$,a,1)=Chr$(13) then 
  150.             Mk$=Mk$ + ","
  151.             a=a+1
  152.         else
  153.             Mk$=Mk$ + Mid$(Information$,a,1)
  154.         End If
  155.         
  156.         a=a+1
  157.     Wend
  158.     MakeComma$=mk$
  159.  
  160. End Function
  161.  
  162. /* **************************************************************************************
  163. * 
  164. *    Function:    DeleteGroup
  165. *    Parameters:Group$
  166. *    Purpose:    This Deletes a group from the shell
  167. *        e.g DeleteGroup "Main"
  168. ******************************************************************************************/
  169.  
  170.  
  171. sub DeleteGroup (Group$)
  172.     GroupList$=MakeComma$(DDEget$("PROGMAN"))
  173.     GroupList$=","+GroupList$+","
  174.     If InStr(GroupList$,","+Group$+",")<>0 then
  175.         Group$= "[DeleteGroup("+CHR$(34)+Group$+CHR$(34)+")]" 
  176.         DDEExe Group$ 
  177.     end if
  178. End Sub
  179.  
  180. /* **************************************************************************************
  181. * 
  182. *    Function:    AddItem
  183. *    Parameters:Group$
  184. *    Purpose:    This adds a new item to the currently highlighted group
  185. *        AddItem "item data"
  186. *        e.g.
  187. *        AddItem Item$
  188. *    Items$ =Command Line including parameters+
  189. *        Title of icon+
  190. *        Icon Path+
  191. *        Icon Index (default is zero for the first index)+
  192. *        Xpos (position of icon on X axis)+
  193. *        Ypos (position of icon on Y axis)+
  194. *        Startup directory
  195. *
  196. *    Notes:The items "Command Line","Title os Icon" need to be enclosed within quotes
  197. *        Each item needs to seperated by a comma    
  198. ******************************************************************************************/
  199.  
  200. sub AddItem (Group$)
  201.     Group$= "[AddItem("+Group$+")]" 
  202.     DDEExe Group$ 
  203. End Sub
  204.  
  205. /* **************************************************************************************
  206. * 
  207. *    Function:    ShowGroup
  208. *    Parameters:Group$
  209. *    Purpose:    This brings a group to the front and highlights it
  210. *        e.g ShowGroup "Main"
  211. ******************************************************************************************/
  212.  
  213. sub ShowGroup(Group$)
  214.  
  215.     Group$="[ShowGroup("+Group$+")]"
  216.     DDEexe Group$ 
  217.  
  218. End Sub
  219.  
  220.  
  221. /* **************************************************************************************
  222. * 
  223. *    Function:    GetGroup$
  224. *    Parameters:NONE
  225. *    Purpose:    This returns a list of groups under your current shell
  226. *
  227. ******************************************************************************************/
  228.  
  229. Function GetGroup$()
  230.  
  231.     GetGroup$=DDEget("PROGMAN")
  232.  
  233. End Function
  234.  
  235.  
  236.  
  237.  
  238. /* **************************************************************************************
  239. * 
  240. *    Function:    MakeNDWValid$
  241. *    Parameters:Cmd$
  242. *    Purpose:   This converts the information received from the shell into a format
  243. *        acceptable to be sent back to the shell
  244. *
  245. ******************************************************************************************/
  246.  
  247. function MakeNDWValid$(Cmd$)
  248.  
  249.     Dim Comma1,Comma2,Comma3,Comma4 as integer
  250.     Dim Comma5,Comma6,Comma7,Comma8 as integer
  251.     Dim FileName$,Description$,IconFile$,StartDir$ as String    
  252.     dim IconPos as Long
  253.  
  254.     Comma1 = InStr(1,Cmd$,",")
  255.     Comma2 = InStr(Comma1+1,Cmd$,",")
  256.     Comma3 = InStr(Comma2+1,Cmd$,",")
  257.     Comma4 = InStr(Comma3+1,Cmd$,",")
  258.     Comma5 = InStr(Comma4+1,Cmd$,",")
  259.     Comma6 = InStr(Comma5+1,Cmd$,",")
  260.     Comma7 = InStr(Comma6+1,Cmd$,",")
  261.     Comma8 = InStr(Comma7+1,Cmd$,",")
  262.     
  263.     Description$ = MakeCompat$(Mid$(Cmd$,1,Comma1-1))
  264.     FileName$ = MakeCompat$(Mid$(Cmd$,Comma1+1,Comma2-Comma1-1))
  265.     StartDir$ = Mid$(Cmd$,Comma2+1,Comma3-Comma2-1)
  266.     IconFile$ = Mid$(Cmd$,Comma3+1,Comma4-Comma3-1)
  267.     x$ = Mid$(Cmd$,Comma4+1,Comma5-Comma4-1)
  268.     Y$ = Mid$(Cmd$,Comma5+1,Comma6-Comma5-1)
  269.     z$ = Mid$(Cmd$,Comma6+1,Comma7-Comma6-1)
  270.     H$ = Mid$(Cmd$,Comma7+1,Comma8-Comma7-1)
  271.     IconPos=val(z$)
  272.  
  273.     If (IconPos < 0) then 
  274.     ' Ndw is the shell, so we must add the magic number
  275.         IconPos=IconPos+32768
  276.     end if
  277.  
  278.     Cmd$=FileName$ +","+ Description$ +","+IconFile$+","+str$(IconPos)+","+x$+","+y$+","+StartDir$+","+h$
  279.     MakeNDWValid$=Cmd$
  280. end function
  281.  
  282.  
  283. /* **************************************************************************************
  284. * 
  285. *    Procedure:    InformUser
  286. *    Parameters:Cmd% , Comp$
  287. *    Purpose:    This allows the program to inform the user of what is happening
  288. *    Notes:    Legal command values:
  289. *            1= Open Window
  290. *            2= Update Message
  291. *            3= Close Windows
  292. *        Legel Comp values are 0-100
  293. ******************************************************************************************/
  294.  
  295. sub InformUser(Cmd%,Comp%)
  296.  
  297.     if Cmd%=1 then 'Create Window 
  298.         MsgOpen "Saving Group Information..Please Wait..",0,0,1,1900,2550
  299.     end If
  300.  
  301.     If Cmd%=2 then ' Update Thermometer
  302.         MsgSetThermometer Comp%
  303.     End if
  304.  
  305.     If Cmd%=3 then 'Close down Completed
  306.         MsgClose
  307.         MsgBox "Finishing saving group information",0,"Save 'A Group"
  308.     End if
  309.  
  310.  
  311. end sub
  312.  
  313.  
  314. /* **************************************************************************************
  315. * 
  316. *    Function:    SaveGroupNames
  317. *    Parameters:Grp$
  318. *    Purpose:    This converts the information received by GetGroups, into a list of groups
  319. *        in the file GROUPS.INI
  320. *    Notes:    The program will exclude any groups with the same name as your "Quick Access"
  321. *        Groups
  322. *
  323. *
  324. ******************************************************************************************/
  325.  
  326. sub SaveGroupNames(Grp$)
  327.  
  328.     a=0
  329.     b=1
  330.     c=1
  331.     QAGrp$=Ucase$(ReadIni$("Quick Access","MainGroup","NDW.INI"))
  332.     While (c<=len(Grp$))
  333.         
  334.         b=InStr(c,Grp$,",")
  335.         g$=Mid$(Grp$,c,b-c)
  336.         if (Ucase$(g$)<>QAGrp$) then
  337.             a=a+1
  338.             l$="GROUP"+Str$(a)
  339.             WriteIni "GROUPS",l$,encap$(g$),"GROUPS.INI"
  340.  
  341.         end if
  342.         c=b+1
  343.     Wend
  344.     WriteIni "GROUPS","TOTAL",Str$(a),"GROUPS.INI"
  345.     WriteIni "GROUPS","DATE",Date$(),"GROUPS.INI"
  346. end sub
  347.  
  348.  
  349.  
  350. /* **************************************************************************************
  351. * 
  352. *    Function:    SaveGroupData
  353. *    Parameters:Group$
  354. *    Purpose:    This saves the information for a specific group to the Groups.INI file
  355. *
  356. ******************************************************************************************/
  357.  
  358.  
  359. sub SaveGroupData(Group$)
  360.  
  361.     GroupInfo$=DDEget$(Group$)
  362.     
  363.     a=1
  364.     b=1
  365.     c=1
  366.     GroupInfo$ = Mid$(GroupInfo$,InStr(c,GroupInfo$,chr$(13))+1,len(GroupInfo$))
  367.     While (c<>len(GroupInfo$))
  368.         b=InStr(c,GroupInfo$,chr$(13))
  369.         g$=Mid$(GroupInfo$,c+1,b-c)
  370.         G$ = MakeNDWValid$(G$)
  371.         l$="Item"+Str$(a)
  372.         WriteIni Group$,l$,g$,"GROUPS.INI"
  373.         a=a+1
  374.         c=b+1        
  375.     Wend
  376.     WriteIni Group$,"TOTAL",str$(a-1),"GROUPS.INI"    
  377.  
  378. End Sub
  379.  
  380.  
  381. /* **************************************************************************************
  382. * 
  383. *    Function:    SaveGroupData
  384. *    Parameters:Group$
  385. *    Purpose:    This saves the information for a specific group to the Groups.INI file
  386. *
  387. ******************************************************************************************/
  388.  
  389. sub SaveAllGroups(Group$)
  390.  
  391.     
  392.     c=0
  393.     TotalGroups = Val ( ReadIni$("Groups","TOTAL","GROUPS.INI"))
  394.     InformUser 1,0
  395.     While (c<TotalGroups)
  396.         c=c+1
  397.         l$=Str$(c)
  398.         l$="GROUP"+l$
  399.         g$=ReadIni$("GROUPS",l$,"GROUPS.INI")
  400.         InformUser 2,int((c/TotalGroups)*100)
  401.         SaveGroupData(g$)
  402.     Wend
  403.     InformUser 3,0
  404. end sub
  405.  
  406. /* **************************************************************************************
  407. * 
  408. *    Function:    RestoreGroup
  409. *    Parameters:Group$
  410. *    Purpose:    This rebuilds the group based upon information for a specific group 
  411. *        in the Groups.INI file
  412. *
  413. ******************************************************************************************/
  414.  
  415. sub RestoreGroup(Group$)
  416.  
  417.  
  418.     Dim TotalItems as Integer
  419.     Dim CurrentItem as Integer
  420.     Dim L$ as String
  421.             
  422.     TotalItems=0
  423.     CurrentItem=0
  424.  
  425.     TotalItems = Val( ReadIni$(Group$,"TOTAL","GROUPS.INI") )
  426.  
  427.     If TotalItems >50 then
  428.         TotalItems = 50
  429.     End if
  430.  
  431.     If (TotalItems <> 0) then
  432.         Grp$ = Group$
  433.         CreateGroup (Grp$)
  434.         CurrentItem=1
  435.  
  436.         While (CurrentItem <= TotalItems)
  437.  
  438.             l$="Item"+Str$(CurrentItem)
  439.             Cmd$=ReadIni$(Group$,l$,"GROUPS.INI")
  440.             Comma1 = InStr(Cmd$,",")
  441.             Title$=Mid$(Cmd$,Comma1+1,InStr(Comma1+1,Cmd$,",")-Comma1-1)
  442.             AddItem Cmd$ 
  443.             CurrentItem=CurrentItem+1
  444.         Wend
  445.     End if
  446. end sub    
  447.  
  448. /* **************************************************************************************
  449. * 
  450. *    Function:    CheckRestore
  451. *    Parameters:None
  452. *    Purpose:    This confirm's whether the user is sure about the restore.
  453. *
  454. ******************************************************************************************/
  455.  
  456.  
  457. function CheckRestore(Msg$)
  458.  
  459.     GroupDate$ = ReadIni$("GROUPS","DATE","GROUPS.INI")
  460.  
  461.     Begin Dialog ConfirmDialog 125,26,214,158, "Confirm Restoration of Groups"
  462.         PushButton 30,120,60,20, "Continue"
  463.         CancelButton 129,120,60,20
  464.         Text 59,8,114,8, "Restoration of Groups"
  465.         Text 98,60,43,8, GroupDATE$
  466.         Text 10,30,96,8, "You are about to restore your"
  467.         Text 10,60,88,8, "groups was taken on the :"
  468.         Text 10,45,193,8, "from the GROUPS.INI file. The last Snapshot of your"
  469.         Text 107,30,100,8, Msg$
  470.         Text 11,82,174,8, "If you wish to proceed, then Click 'Continue'"
  471.         Text 11,95,174,8, "Otherwise, click on 'Cancel' to exit"
  472.     End Dialog
  473.  
  474.     Dim TmpDlg as ConfirmDialog
  475.  
  476.     CheckRestore=Dialog(TmpDlg)
  477.  
  478. end function
  479.  
  480.  
  481. /* **************************************************************************************
  482. * 
  483. *    Function:    RestoreAllGroup
  484. *    Parameters:None
  485. *    Purpose:    This rebuilds all the groups based upon information in the Groups.INI file
  486. *
  487. ******************************************************************************************/
  488.  
  489. sub RestoreAllGroups()
  490.  
  491.     Dim TotalGroups,CurrentGroup as Integer
  492.     Dim l$,Group$ as String
  493.  
  494.     TotalGroups=0
  495.     CurrentGroup=0
  496.  
  497.     TotalGroups = val( ReadIni$("GROUPS","TOTAL","GROUPS.INI"))
  498.  
  499.     if TotalGroups <> 0 then 
  500.  
  501.         if CheckRestore("program groups")<>0 then
  502.  
  503.             CurrentGroup=1
  504.             While (CurrentGroup<=TotalGroups)
  505.     
  506.                 l$="GROUP"+Str$(CurrentGroup)
  507.                 Group$ = ReadIni$("GROUPS",l$,"GROUPS.INI")
  508.                 Grp$ = Group$
  509.                 DeleteGroup Grp$
  510.                 Grp$ = Group$
  511.                 CreateGroup Grp$ 
  512.                 RestoreGroup Group$
  513.                 CurrentGroup=CurrentGroup+1
  514.             Wend
  515.         MsgBox "Finishing restoring group information",0,"Save 'A Group"
  516.         End If
  517.     End if
  518.  
  519. End Sub
  520.  
  521.  
  522. /* **************************************************************************************
  523. * 
  524. *    Function:    RestoreOneGroup
  525. *    Parameters:None
  526. *    Purpose:    This rebuilds one the groups based upon information in the Groups.INI file
  527. *
  528. ******************************************************************************************/
  529.  
  530. sub RestoreOneGroup()
  531.  
  532.     Dim GrpList$ (1 to 60)
  533.  
  534.     Begin Dialog RestDlg 176,32,135,157, "Restore One Group"
  535.         CancelButton 81,140,41,14
  536.         PushButton 10,140,52,14, "Restore"
  537.         ListBox 14,15,110,96, GrpList$, .GrpSelected
  538.         Text 3,120,128,15, "Select Group to restore then click on 'Restore' or 'Cancel' to exit."
  539.     End Dialog
  540.  
  541.  
  542.     Dim SelDlg as RestDlg
  543.  
  544.     TotalGroups=0
  545.  
  546.     TotalGroups = val( ReadIni$("GROUPS","TOTAL","GROUPS.INI"))
  547.  
  548.     if (TotalGroups <> 0) then
  549.         ReDim GrpList$ (1 to TotalGroups+1)
  550.         Counter = 0
  551.         While (Counter <=TotalGroups) 
  552.             Counter=Counter+1
  553.             Itm$ = "GROUP"+Str$(Counter)
  554.             GrpList$ (Counter) = ReadIni$("GROUPS",Itm$,"GROUPS.INI")
  555.         Wend
  556.         result=Dialog(SelDlg)
  557.         if (result<>0) then 
  558.             Group$=GrpList$(SelDlg.GrpSelected)
  559.             if (CheckRestore("the group "+group$+" from the")<>0) then 
  560.                 RestoreGroup(Group$)
  561.                 MsgBox "Finishing restoring group information",0,"Save 'A Group"
  562.             End if
  563.         End if
  564.         
  565.     End if
  566. end sub
  567.  
  568. /* **************************************************************************************
  569. * 
  570. *    Function:    main
  571. *    Parameters:None
  572. *    Purpose:    This is the main calling routine, execution starts here.
  573. *
  574. ******************************************************************************************/
  575.  
  576.         
  577. const IDB_CANCEL     = 0
  578. const IDB_SAVE        = 1
  579. const IDB_RESTORE_ONE    = 2
  580. const IDB_RESTORE_ALL    = 3
  581.  
  582. sub main()
  583.  
  584. ' Enable 3D Dialog box effects
  585.  
  586.  result=Ctl3dRegister(0)
  587.  if (result = 1) then
  588.   result=Ctl3dAutoSubClass(0)
  589.   Enable3D=1
  590.  end if
  591.  
  592.  On Error goto ErrorMsg
  593.  
  594.     Begin Dialog MenuDialog 53,45,358,137, "Save 'A Group"
  595.         CancelButton 280,100,70,20
  596.         PushButton 280,15,70,20, "Save All Groups"
  597.         PushButton 280,65,70,20, "Restore One Group"
  598.         PushButton 280,40,70,20, "Restore All Groups"
  599.         Text 99,31,57,8, "By Rob Harford"
  600.         Text 49,19,214,8, "Writen using the Symantec Scripting Language"
  601.         Text 100,8,75,8, "DDE Example program"
  602.         Text 20,100,254,8, "'Restore All Groups' will restore the backup made by using 'Save ALL Groups'"
  603.         Text 20,90,236,8, "'Save All Groups' will make a copy the groups  under your current shell."
  604.         Text 22,50,196,8, "This utility will save and restore groups from different shells"
  605.         Text 22,65,238,8, "This program will run under different shells (e.g NDW,Program Manager)"
  606.         Text 85,78,81,8, "------------------------------------"
  607.         Text 20,110,256,8, "'Restore One Group' will allow you to restore just one group from your backup"
  608.         Text 20,120,256,8, "'Cancel' will exit from this program"
  609.         Text 341,127,14,8, "1.4"
  610.     End Dialog
  611.  
  612.      Dim Dialog1 as  MenuDialog
  613.     
  614.     result =-1
  615.     While (Result<>0)
  616.         result = Dialog(Dialog1)
  617.         if result = IDB_SAVE then 
  618.             Group$ = GetGroup$()
  619.             Group$ = MakeComma$(Group$)
  620.             SaveGroupNames(Group$)
  621.             SaveAllGroups(Group$)
  622.         end if
  623.     
  624.         if result = IDB_RESTORE_ALL then
  625.             RestoreAllGroups
  626.         end if
  627.     
  628.         if result = IDB_RESTORE_ONE then
  629.             RestoreOneGroup
  630.         end if
  631.     Wend
  632.     Goto GoodEnd
  633.  
  634. ErrorMsg:
  635.     MsgBox "Sorry a Fatal Error occured"
  636.  
  637. GoodEnd:
  638.  
  639. ' Remove 3d Dialogs
  640.  if (Enable3D=1) then 
  641.    result=Ctl3dUnRegister(0)
  642.    Sleep 500
  643.  end if
  644.  
  645. end sub
  646.  
  647.